home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rotate2a / angbutto.ctl < prev    next >
Text File  |  1999-10-18  |  11KB  |  330 lines
  1. VERSION 5.00
  2. Begin VB.UserControl angButton 
  3.    ClientHeight    =   1245
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   1395
  7.    ForeColor       =   &H8000000F&
  8.    MousePointer    =   2  'Cross
  9.    ScaleHeight     =   83
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   93
  12.    ToolboxBitmap   =   "angButton.ctx":0000
  13.    Begin VB.PictureBox picMask 
  14.       Appearance      =   0  'Flat
  15.       BorderStyle     =   0  'None
  16.       DrawWidth       =   2
  17.       ForeColor       =   &H80000008&
  18.       Height          =   1320
  19.       Left            =   0
  20.       ScaleHeight     =   88
  21.       ScaleMode       =   3  'Pixel
  22.       ScaleWidth      =   96
  23.       TabIndex        =   1
  24.       Top             =   0
  25.       Width           =   1440
  26.    End
  27.    Begin VB.PictureBox picImage 
  28.       AutoRedraw      =   -1  'True
  29.       Height          =   1260
  30.       Left            =   1440
  31.       Picture         =   "angButton.ctx":0312
  32.       ScaleHeight     =   80
  33.       ScaleMode       =   3  'Pixel
  34.       ScaleWidth      =   160
  35.       TabIndex        =   0
  36.       Top             =   0
  37.       Visible         =   0   'False
  38.       Width           =   2460
  39.    End
  40. End
  41. Attribute VB_Name = "angButton"
  42. Attribute VB_GlobalNameSpace = False
  43. Attribute VB_Creatable = True
  44. Attribute VB_PredeclaredId = False
  45. Attribute VB_Exposed = False
  46. '-----------------------------------------------------
  47. ' AngButton (c) Copyright Emilio Aguirre 1999
  48. '               eaguirre@comtrade.com.mx
  49. '_----------------------------------------------------
  50. Option Explicit
  51. 'Types
  52. Private Type POINTAPI
  53.    x As Long
  54.    y As Long
  55. End Type
  56.  
  57. Private Type LOGBRUSH
  58.         lbStyle As Long
  59.         lbColor As Long
  60.         lbHatch As Long
  61. End Type
  62.  
  63. 'API Declares & Constants
  64. Const SRCAND = &H8800C6          ' (DWORD) dest = source AND dest
  65. Const SRCPAINT = &HEE0086        ' (DWORD) dest = source OR dest
  66. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
  67.     ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
  68.     ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  69. Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, _
  70.         ByVal nCount As Long) As Long
  71. Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
  72. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  73. Private Declare Function SetPolyFillMode Lib "gdi32" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long
  74. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  75. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  76.  
  77. Const BS_SOLID = 0
  78.    
  79. 'Enumarations
  80. Enum TraceValue
  81.   Set_Off = 0
  82.   Set_On = 1
  83. End Enum
  84.  
  85. 'Default Property Values:
  86. Const m_def_Angle = 0
  87. Const m_def_Color = vbRed
  88. Const m_def_Trace = Set_On
  89. Const m_PI = 3.14159265358979
  90.  
  91. 'Property Variables:
  92. Dim m_Angle As Integer
  93. Dim m_Color As OLE_COLOR
  94. Dim m_Trace As TraceValue
  95. Dim m_blnMouse As Boolean
  96. 'Value of angle in degrees
  97. Public Property Get Angle() As Integer
  98.     Angle = m_Angle
  99. End Property
  100.  
  101. Public Property Let Angle(ByVal New_Angle As Integer)
  102.     m_Angle = New_Angle
  103.     PropertyChanged "Angle"
  104. End Property
  105. 'Draw color
  106. Public Property Get color() As OLE_COLOR
  107.     color = m_Color
  108. End Property
  109.  
  110. Public Property Let color(ByVal New_Color As OLE_COLOR)
  111.     m_Color = New_Color
  112.     PropertyChanged "Color"
  113.     PaintControl
  114. End Property
  115. 'Value of trace mode
  116. Public Property Get Trace() As TraceValue
  117.     Trace = m_Trace
  118. End Property
  119.  
  120. Public Property Let Trace(ByVal New_Trace As TraceValue)
  121.     m_Trace = New_Trace
  122.     PropertyChanged "Trace"
  123.     PaintControl
  124. End Property
  125.  
  126. Private Sub picMask_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  127.   If (Not m_blnMouse) Then m_blnMouse = True
  128.   CalculateNewAngle x, y
  129. End Sub
  130.  
  131. Private Sub picMask_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  132. If ((Button And vbLeftButton) > 0) And (m_blnMouse) Then
  133.    CalculateNewAngle x, y
  134. End If
  135. End Sub
  136.  
  137. Private Sub picMask_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  138. If (m_blnMouse) Then m_blnMouse = False
  139. End Sub
  140.  
  141. Private Sub picMask_Paint()
  142. PaintControl
  143. End Sub
  144.  
  145. Private Sub UserControl_Resize()
  146. Height = 1200: Width = 1200 'Force to keep original values in twips
  147. picMask.Height = 1200
  148. picMask.Width = 1200
  149. PaintControl
  150. End Sub
  151.  
  152. 'Load property values from storage
  153. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  154.     m_Angle = PropBag.ReadProperty("Angle", m_def_Angle)
  155.     m_Color = PropBag.ReadProperty("Color", m_def_Color)
  156.     m_Trace = PropBag.ReadProperty("Trace", m_def_Trace)
  157. End Sub
  158.  
  159. 'Write property values to storage
  160. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  161.     Call PropBag.WriteProperty("Angle", m_Angle, m_def_Angle)
  162.     Call PropBag.WriteProperty("Color", m_Color, m_def_Color)
  163.     Call PropBag.WriteProperty("Trace", m_Trace, m_def_Trace)
  164. End Sub
  165.  
  166. 'Initialize Properties for User Control
  167. Private Sub UserControl_InitProperties()
  168.     m_Angle = m_def_Angle
  169.     m_Color = m_def_Color
  170.     m_Trace = m_def_Trace
  171. End Sub
  172.  
  173. Private Sub CalculateNewAngle(x As Single, y As Single)
  174. Dim intX As Integer
  175. Dim intY As Integer
  176. Dim intAngle As Integer
  177. Dim blnNoKeep As Boolean    'Flag for prevent redrawing when it is not necessary
  178. blnNoKeep = True
  179. If y > 40 Then
  180.     ' Plus button. Increments the angle by one
  181.     If (x > 3) And (x < 15) And (y > 58) And (y < 68) Then
  182.       intAngle = Angle + 1
  183.       If intAngle > 180 Then intAngle = 180
  184.     ElseIf (x > 63) And (x < 74) And (y > 58) And (y < 68) Then
  185.     ' Minus buton. Decrements the angle by one
  186.        intAngle = Angle - 1
  187.        If intAngle < 0 Then intAngle = 0
  188.     Else
  189.        blnNoKeep = False
  190.     End If
  191. Else
  192.     'Calculate the position of the click button, in a standard coordinate
  193.     'system.
  194.     intX = x - 40
  195.     intY = (y - 40) * -1
  196.     If intY = 0 Then
  197.        If intX > 0 Then
  198.          intAngle = 0
  199.        Else
  200.          intAngle = 180
  201.         End If
  202.     Else
  203.       If intY > 0 Then
  204.         If intX = 0 Then
  205.           intAngle = 90
  206.         Else
  207.           intAngle = (Atn(intY / intX) * (180 / m_PI))
  208.         End If
  209.         If (intAngle < 0) Then intAngle = 180 + intAngle
  210.       Else
  211.         blnNoKeep = False 'No repainting
  212.       End If
  213.     End If
  214. End If
  215. If blnNoKeep Then
  216.    Angle = intAngle
  217.    PaintControl
  218. End If
  219. End Sub
  220.  
  221. Private Sub PaintControl()
  222. Dim sngTheta As Single          'Angle in Radians
  223. Dim j As Integer
  224. Dim ang As Integer
  225. Dim col As Long
  226. Dim m_P(3) As POINTAPI
  227. Dim m_R(3) As POINTAPI
  228. Dim lb As LOGBRUSH
  229. Dim brush As Long
  230. Dim pen As Long
  231.  
  232. ang = Angle
  233. col = color
  234. m_P(0).x = 36:  m_P(0).y = 0
  235. m_P(1).x = 27: m_P(1).y = 0
  236. m_P(2).x = 10:  m_P(2).y = 5
  237. m_P(3).x = 10:  m_P(3).y = -5
  238. 'Drawing the background
  239. BitBlt picMask.hdc, 0, 0, 79, 79, picImage.hdc, 80, 0, SRCAND
  240. BitBlt picMask.hdc, 0, 0, 79, 79, picImage.hdc, 0, 0, SRCPAINT
  241. 'Drawing the angle marker
  242. sngTheta = -ang * m_PI / 180
  243. If Trace = Set_Off Then
  244.     'Trace off option
  245.      For j = 0 To 3
  246.       If j = 0 Then
  247.         picMask.DrawWidth = 5
  248.       Else
  249.         picMask.DrawWidth = 1
  250.       End If
  251.       m_R(j).x = (m_P(j).x * Cos(sngTheta) - m_P(j).y * Sin(sngTheta)) + 40
  252.       m_R(j).y = (m_P(j).x * Sin(sngTheta) + m_P(j).y * Cos(sngTheta)) + 40
  253.       picMask.PSet (m_R(j).x, m_R(j).y), col
  254.     Next j
  255.     picMask.DrawWidth = 2
  256.     
  257.     lb.lbStyle = BS_SOLID
  258.     lb.lbColor = col
  259.     lb.lbHatch = 0
  260.     brush = CreateBrushIndirect(lb)
  261.     pen = CreatePen(0, 1, col)
  262.     SelectObject picMask.hdc, brush
  263.     SelectObject picMask.hdc, pen
  264.     Polygon picMask.hdc, m_R(1), 3
  265.     DeleteObject pen
  266.     DeleteObject brush
  267. Else
  268.    'Trace on option
  269.    picMask.DrawWidth = 5
  270.    m_R(0).x = (m_P(0).x * Cos(sngTheta) - m_P(0).y * Sin(sngTheta)) + 40
  271.    m_R(0).y = (m_P(0).x * Sin(s